home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Developer / macgambit-20-compiler-src-p1 / Runtime (.c & .h) / mem.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-07-26  |  17.5 KB  |  586 lines  |  [TEXT/KAHL]
  1. /* Memory allocation */
  2.  
  3. #include "params.h"
  4. #include "gambit.h"
  5. #include "struct.h"
  6. #include "os.h"
  7. #include "mem.h"
  8. #include "strings.h"
  9. #include "opcodes.h"
  10. #include "stats.h"
  11. #include "main.h"
  12.  
  13.  
  14. /*---------------------------------------------------------------------------*/
  15.  
  16.  
  17. void (*temp_cont)();
  18. char *heap_area1, *heap_area2;
  19. long random_seed;
  20. long processor_id;
  21. PSTATE_PTR processor_state[MAX_NB_PROC];
  22.  
  23.  
  24.  
  25. void init_system_mem1();
  26.  
  27.  
  28. void init_system_mem( cont )
  29. void (*cont)();
  30. {
  31.  
  32. /*
  33.  
  34. This procedure allocates storage that is global to the system and used
  35. by all processors.  This storage is subdivided into 3 areas:
  36.  
  37.   1 - system state
  38.   2 - global table (contains Scheme global variables)
  39.   3 - constant space (contains the code for procedures and constant objects)
  40.  
  41. The part containing the global variables is allocated on processor 0 (as
  42. shared memory) and every processor get's a copy of the rest.  The block
  43. is organized as follows:
  44.  
  45.                   _________
  46.        / -0x8000 |    .    | \
  47.       |          |    .    |  |
  48.       |          |    .    |  | 6528 global variables (each var.
  49.       |          |    .    |  | occupies 8 bytes, the first 4 are the
  50. shared           |    .    |  | variable's value the next 4 are the jump
  51.       | A6 --> 0 |    .    |  | address)
  52.       |          |    .    |  |
  53.       |          |    .    |  |
  54.        \         |_________| /
  55.                  |    .    | \
  56.        /         |    .    |  | 6528/2 'global jump' trampolines (each occupies
  57.       |          |    .    |  | 4 bytes and corresponds to 'jmp 0x7efe(A6)')
  58.       |          |_________| /
  59.       |   0x7f00 |    .    | \
  60.       |          |    .    |  | 32 trap handler trampolines (each occupies 8
  61.       |          |    .    |  | bytes and correspond to 'jmp adr')
  62. copy             |_________| /
  63.       |   0x8000 |    .    | \
  64.       |          |    .    |  |
  65.       |          |    .    |  | 'constants' area
  66.       |          |    .    |  |
  67.       \          |_________| /
  68.  
  69.  
  70. */
  71.  
  72.   temp_cont = cont;
  73.  
  74.   os_shared_copy_malloc8(
  75.     (long)(ceiling8( sizeof(struct sstate_rec) ) +
  76.            ((long)MAX_NB_GLOBALS)*sizeof(struct global_rec)),
  77.     (long)(((long)MAX_NB_GLOBALS)*sizeof(short) +
  78.            ((long)NB_TRAPS)*sizeof(struct trap_rec) +
  79.            ceiling8( const_len ))
  80.     , 0L
  81.     , init_system_mem1 );
  82. }
  83.  
  84.  
  85. void init_system_mem1( const_area )
  86. char *const_area;
  87. { long nb_processors;
  88.  
  89.   if (const_area == NULL)
  90.   { os_warn( "Can't allocate constant area\n", 0L ); os_quit(); }
  91.  
  92.   nb_processors = os_nb_processors();
  93.  
  94.   if (remote) nb_processors = 1;
  95.  
  96.   if (nb_processors > MAX_NB_PROC)
  97.   { nb_processors = MAX_NB_PROC;
  98.     os_warn( "Maximum number of processors (%d) will be used\n",
  99.              (long)MAX_NB_PROC );
  100.   }
  101.  
  102.   { char *ptr1 = const_area + ceiling8( sizeof(struct sstate_rec) );
  103.     char *ptr2 = ptr1 + ((long)MAX_NB_GLOBALS)*(sizeof(struct global_rec) + sizeof(short) );
  104.     char *ptr3 = ptr2 + ((long)NB_TRAPS)*sizeof(struct trap_rec);
  105.     long i;
  106.  
  107.     sstate = (SSTATE_PTR)const_area;
  108.     sstate->globals    = (GLOBAL_PTR)ptr1;
  109.     sstate->tramps     = (TRAMP_PTR)(ptr2-((long)MAX_NB_GLOBALS)*sizeof(short));
  110.     sstate->traps      = (TRAP_PTR)ptr2;
  111.     sstate->const_bot  = ptr3;
  112.     sstate->const_bptr = ptr3;
  113.     sstate->const_tptr = ptr3 + ceiling8( const_len );
  114.     sstate->const_top  = ptr3 + ceiling8( const_len );
  115.     sstate->nb_ofiles  = 0;
  116.  
  117.     /* init global variable table and global jump trampolines */
  118.  
  119.     for (i=0; i<(long)MAX_NB_GLOBALS; i++)
  120.     { sstate->globals[i].value    = (long)SCM_unbound;
  121.       sstate->globals[i].jump_adr = (long)&sstate->tramps[i];
  122.       if (i & 1)
  123.         sstate->tramps[i] = JMPA6_DISP_OP;
  124.       else
  125.         sstate->tramps[i] = 0x7efe; /* offset and opcode for moveq #-2,d7 */
  126.     }
  127.     sstate->tramps[((long)MAX_NB_GLOBALS)-1] = NOP_OP;
  128.  
  129.     temp_cont( nb_processors );
  130.   }
  131. }
  132.  
  133.  
  134. long alloc_const_proc( len, obj )
  135. long len;
  136. SCM_obj *obj;
  137. { long len1 = len + 4;        /* length including header                */
  138.   long len2 = ceiling8(len1); /* length including padding for alignment */
  139.   char *temp = sstate->const_bptr;
  140.   if (temp + len2 > sstate->const_tptr)
  141.   { os_err = "Constant area overflow"; return 1; }
  142.   sstate->const_bptr = temp + len2;
  143.   *(short *)temp = 0x8000 + len;
  144.   *obj = (SCM_obj)(temp + SCM_type_PROCEDURE);
  145.   return 0;
  146. }
  147.  
  148.  
  149. long alloc_const_pair( obj )
  150. SCM_obj *obj;
  151. { if (sstate->const_tptr-8 < sstate->const_bptr)
  152.   { os_err = "Constant area overflow"; return 1; }
  153.   sstate->const_tptr -= 8;
  154.   *obj = (SCM_obj)(sstate->const_tptr + SCM_type_PAIR);
  155.   return 0;
  156. }
  157.  
  158.  
  159. long alloc_const_subtyped( len, subtype, obj )
  160. long len, subtype;
  161. SCM_obj *obj;
  162. { long len1 = len + 4;        /* length including header                */
  163.   long len2 = ceiling8(len1); /* length including padding for alignment */
  164.   if (sstate->const_bptr+len2 > sstate->const_tptr)
  165.   { os_err = "Constant area overflow"; return 1; }
  166.   *obj = (SCM_obj)(sstate->const_bptr + SCM_type_SUBTYPED);
  167.   *(long *)(sstate->const_bptr) = SCM_make_header( len, subtype );
  168.   sstate->const_bptr += len2;
  169.   return 0;
  170. }
  171.  
  172.  
  173. long alloc_const_vector( len, obj )
  174. long len;
  175. SCM_obj *obj;
  176. { return alloc_const_subtyped( len*sizeof(SCM_obj), (long)SCM_subtype_VECTOR, obj );
  177. }
  178.  
  179.  
  180. long alloc_const_string( str, obj )
  181. char *str;
  182. SCM_obj *obj;
  183. { SCM_obj string_adr;
  184.   char *p = str;
  185.   long len = 0;
  186.   while (*(p++) != '\0') len++;
  187.   if (alloc_const_subtyped( len+1, (long)SCM_subtype_STRING, &string_adr )) return 1;
  188.   p = (char *)(string_adr - SCM_type_SUBTYPED + 4);
  189.   while (*str != '\0') *(p++) = *(str++);
  190.   *p = '\0'; /* so that C will understand this as a string */
  191.   if ((((long)p) & 7) == 0) { *(long *)p = 0; *(long *)(p+4) = 0; }
  192.   *obj = string_adr;
  193.   *(long *)(string_adr-SCM_type_SUBTYPED) = SCM_make_header( len, SCM_subtype_STRING );
  194.   return 0;
  195. }
  196.  
  197.  
  198. void define_c_proc( name, proc )
  199. char *name;
  200. void (*proc)();
  201. { SCM_obj proc_adr;
  202.   short *code_ptr;
  203.   char *str = c_id_to_symbol( name );
  204.   if (str == NULL)
  205.   { os_warn( "Can't convert C identifier to Scheme symbol\n", 0L ); os_quit(); }
  206.   if (alloc_const_proc( 16L, &proc_adr ))
  207.   { os_warn( "%s\n", (long)os_err ); os_quit(); }
  208.   code_ptr = (short *)proc_adr;
  209.  
  210.   *(code_ptr++) = MOVE_L_IMM_A1_OP;      /* move.l #adr,a1    */
  211.   *(void (**)())code_ptr = proc;  code_ptr += 2;
  212.   *(code_ptr++) = JMPA6_DISP_OP;         /* jmp    C_CALL(a6) */
  213.   *(code_ptr++) = table_offset( &sstate->traps[C_CALL_trap].jmp );
  214.   *((SCM_obj *)code_ptr) = SCM_false;  code_ptr += 2;
  215.   *((SCM_obj *)code_ptr) = SCM_int_to_obj( 2 );
  216.  
  217.   if (set_global( str, proc_adr )) { os_warn( "%s\n", (long)os_err ); os_quit(); }
  218. }
  219.  
  220.  
  221. /*---------------------------------------------------------------------------*/
  222.  
  223.  
  224. void init_processor_mem1();
  225. void init_processor_mem2();
  226. void init_processor_mem3();
  227. void init_processor_mem4();
  228.  
  229.  
  230. void init_processor_mem( cont )
  231. void (*cont)();
  232. {
  233.  
  234. /*
  235.  
  236. This procedure allocates storage associated with each processor.
  237. Specifically, there are 8 areas of storage per processor:
  238.  
  239.   1 - table used to store events
  240.   2 - local heap (for storing non-Scheme objects)
  241.   3 - counters used for statistics gathering
  242.   4 - code area for the emulation of M68020 and M68881 instructions
  243.   5 - processor state
  244.   6 - Scheme heap (where the processor allocates most Scheme objects)
  245.   7 - counters used for profiling (if requested)
  246.   8 - the stack (and lazy-task queue and dynamic-binding queue)
  247.       note: the lazy-task queue could be in private-memory for the message
  248.       passing steal protocol but, to test the alternative shared memory steal
  249.       protocol, it is put in shared memory (on the butterfly this doesn't
  250.       affect performance anyway)
  251.  
  252. The processor state is a structure that contains a number of fields that
  253. describe a given processor (i.e. processor number, heap location,
  254. stack location, etc...).
  255.  
  256. The Scheme heap is a block of memory containing two equaly sized sub-heaps
  257. each starting on an octuple address:
  258.  
  259. processor.heap_bot       _________
  260.           ------------> |    .    | \
  261.                         |    .    |  | sub-heap 1 (first to be used)
  262.                         |    .    |  |
  263.                         |_________| /
  264.                         |    .    | \
  265.                         |    .    |  | sub-heap 2
  266.                         |    .    |  |
  267. processor.heap_top      |_________| /
  268.           ------------>
  269.  
  270. */
  271.  
  272.   temp_cont = cont;
  273.  
  274.   init_stats();
  275.  
  276.   processor_id = 0;
  277.   random_seed = 0;
  278.  
  279.   init_processor_mem1();
  280. }
  281.  
  282.  
  283. void init_processor_mem1()
  284. { long prof_len = ceiling8(sstate->profiling ? ((sizeof(short) * ceiling8( const_len )) >> PROF_SHIFT) : 0);
  285.  
  286.   os_shared_malloc8( (remote_stack ? 0 : (2*stack_len)) +
  287.                      ceiling8( ((long)MAX_NB_EVENTS)*sizeof(long) ) +
  288.                      ((long)LOCAL_HEAP_LENGTH_IN_K)*K +
  289.                      ceiling8( ((long)MAX_NB_STATS)*sizeof(long) ) +
  290.                      ceiling8( ((long)MAX_EMUL_CODE_LENGTH_IN_K)*K ) +
  291.                      ceiling8( sizeof(struct pstate_rec) ) +
  292.                      prof_len +
  293.                      (remote_heap ? 0 : heap_len),
  294.                      processor_id,
  295.                      init_processor_mem2 );
  296. }
  297.  
  298.  
  299. void init_processor_mem2( ptr )
  300. char *ptr;
  301. { if (ptr == NULL)
  302.   { os_warn( "Can't allocate heap area\n", 0L ); os_quit(); }
  303.  
  304.   heap_area1 = ptr;
  305.  
  306.   if (remote_heap)
  307.     os_shared_malloc8( heap_len, 1L, init_processor_mem3 );
  308.   else
  309.     init_processor_mem3( heap_area1 );
  310. }
  311.  
  312.  
  313. void init_processor_mem3( ptr )
  314. char *ptr;
  315. { if (ptr == NULL)
  316.   { os_warn( "Can't allocate remote heap\n", 0L ); os_quit(); }
  317.  
  318.   heap_area2 = ptr;
  319.  
  320.   if (remote_stack)
  321.     os_shared_malloc8( 2*stack_len, 1L, init_processor_mem4 );
  322.   else
  323.     init_processor_mem4( heap_area1 );
  324. }
  325.  
  326.  
  327. void init_processor_mem4( ptr )
  328. char *ptr;
  329. { if (ptr == NULL)
  330.   { os_warn( "Can't allocate remote stack\n", 0L ); os_quit(); }
  331.  
  332.   { long prof_len = ceiling8(sstate->profiling ? ((sizeof(short) * ceiling8( const_len )) >> PROF_SHIFT) : 0);
  333.  
  334.     char *ptr0 = heap_area1 + (remote_stack ? 0 : (2*stack_len));
  335.     char *ptr1 = ptr0 + ceiling8( ((long)MAX_NB_EVENTS)*sizeof(long) );
  336.     char *ptr2 = ptr1 + ((long)LOCAL_HEAP_LENGTH_IN_K)*K;
  337.     char *ptr3 = ptr2 + ceiling8( ((long)MAX_NB_STATS)*sizeof(long) );
  338.     char *ptr4 = ptr3 + ceiling8( ((long)MAX_EMUL_CODE_LENGTH_IN_K)*K );
  339.     char *ptr5 = ptr4 + ceiling8( sizeof(struct pstate_rec) );
  340.     char *ptr6 = (remote_heap ? heap_area2 : (ptr5+prof_len));
  341.     PSTATE_PTR p = (PSTATE_PTR)ptr4;
  342.     long i;
  343.  
  344.     processor_state[processor_id] = p;
  345.  
  346.     p->id                = SCM_int_to_obj(processor_id);
  347.     p->nb_processors     = SCM_int_to_obj(nb_processors);
  348.     p->stats_counters    = (long *)ptr2;
  349.     p->local_heap_bot    = ptr1;
  350.     p->local_heap_top    = ptr2;
  351.  
  352.     p->stack_bot         = (long *)ptr;
  353.     p->stack_top         = (long *)(((char *)p->stack_bot) + stack_len);
  354.     p->q_bot             = (long **)p->stack_top;
  355.     p->q_top             = (long **)(((char *)p->stack_top) + stack_len);
  356.     p->stack_max_margin  = ((stack_len-STACK_ALLOCATION_FUDGE*4)/8) & -8L;
  357.     p->stack_margin      = p->stack_max_margin;
  358.  
  359.     p->heap_bot          = ptr6;
  360.     p->heap_top          = ptr6 + heap_len;
  361.     p->heap_mid          = ptr6 + heap_len/2;
  362.     p->heap_max_margin   = ((heap_len/2-HEAP_ALLOCATION_FUDGE*4)/16) & -8L;
  363.     p->heap_margin       = p->heap_max_margin;
  364.     p->elog_bot          = (long *)ptr0;
  365.     p->elog_top          = ((long *)ptr1)-2;
  366.     p->prof_bot          = (short *)ptr5;
  367.     p->prof_top          = (short *)(ptr5+prof_len);
  368.     p->emul_code_bot     = ptr3;
  369.     p->emul_code_top     = ptr4;
  370.  
  371.     p->intr_flag         = -1;
  372.     p->heap_old          = p->heap_mid;
  373.     p->heap_lim          = p->heap_bot + p->heap_margin + ((long)HEAP_ALLOCATION_FUDGE)*4;
  374.     p->heap_ptr          = p->heap_mid;
  375.     p->closure_lim       = p->heap_ptr;
  376.     p->closure_ptr       = p->heap_ptr;
  377.     p->workq_lockO       = 0;  /* work queue initially unlocked */
  378.     p->workq_lockV       = 0;
  379.     p->workq_tail        = SCM_null;
  380.     p->workq_head        = SCM_null;
  381.     p->steal_scan        = 0;
  382.     p->elog_ptr          = p->elog_top;
  383.     p->elog_top[0]       = 0;
  384.     p->elog_top[1]       = 0;
  385.     p->emul_code_ptr     = p->emul_code_bot;
  386.     p->local_heap_ptr    = p->local_heap_bot;
  387.  
  388.     p->steal_lockO       = 0;
  389.     p->steal_lockV       = 0;
  390.  
  391.     p->stack_ptr         = p->stack_top;
  392.     p->ltq_tail          = p->q_bot;
  393.     *(p->ltq_tail++)     = p->stack_ptr;
  394.     p->ltq_head          = p->ltq_tail;
  395.     p->deq_tail          = p->q_top;
  396.     *(--p->deq_tail)     = p->stack_ptr;
  397.     p->deq_head          = p->deq_tail;
  398.  
  399.     { long **z = p->ltq_tail;
  400.       while (z != p->deq_tail) *z++ = NULL;
  401.     }
  402.  
  403.     p->response          = 0;
  404.     p->thief             = 0;
  405.  
  406.     p->intr_other        = 0;
  407.     p->intr_barrier      = 0;
  408.     p->intr_timer        = 0;
  409.     p->intr_user         = 0;
  410.  
  411.     p->sync1             = -2;
  412.     p->sync2             = -2;
  413.  
  414.     p->count1            = 0;
  415.     p->count2            = 0;
  416.  
  417.     for (i=(sizeof(p->processor_storage)/sizeof(SCM_obj))-1; i>=0; i--)
  418.       p->processor_storage[i] = 0;
  419.   }
  420.  
  421.   processor_id++;
  422.  
  423.   if (processor_id<nb_processors)
  424.     init_processor_mem1();
  425.   else
  426.   { long i, j, index;
  427.  
  428.     for (i=0; i<nb_processors; i++)  /* setup table of processors on each proc */
  429.     { PSTATE_PTR *p1 = processor_state[i]->ps, *p2 = processor_state;
  430.       PSTATE_PTR *p3 = processor_state[i]->steal_ps;
  431.       for (j=0; j<nb_processors; j++) *(p1++) = *(p2++);
  432.       *(p3++) = processor_state[i];
  433.       for (j=1; j<nb_processors; j++) *(p3++) = processor_state[(i+j)%nb_processors];
  434.  
  435.       for (j=1; j<nb_processors; j++)  /* shuffle to randomize steal pattern */
  436.       { long k = random_seed % (nb_processors-j);
  437.         PSTATE_PTR temp = *(--p3);
  438.         *p3 = *(p3-k);
  439.         *(p3-k) = temp;
  440.         random_seed = (random_seed * 7001 + 1) & 0x7fffffffL;
  441.       }
  442.     }
  443.  
  444.     pstate = processor_state[0];
  445.   
  446.     if (alloc_vector( (long)SYMBOL_TABLE_LENGTH, &sstate->globals[SYMBOL_TABLE].value )) os_quit();
  447.  
  448.     for (i=0; i<SYMBOL_TABLE_LENGTH; i++)
  449.       SCM_obj_to_vect(sstate->globals[SYMBOL_TABLE].value)[i] = SCM_null;
  450.     sstate->globals[GLOBAL_VAR_COUNT].value = SCM_int_to_obj( 0 );
  451.  
  452.     if (alloc_global( "##symbol-table", &index ) ||               /* variable # 0 */
  453.         alloc_global( "##global-var-count", &index )) os_quit();  /* variable # 1 */
  454.  
  455.     temp_cont();
  456.   }
  457. }
  458.  
  459.  
  460. long alloc_pair( obj )
  461. SCM_obj *obj;
  462. { if (pstate->heap_ptr-8 < pstate->heap_lim)
  463.   { os_err = "Heap overflow"; return 1; }
  464.   pstate->heap_ptr -= 8;
  465.   *obj = (SCM_obj)(pstate->heap_ptr + SCM_type_PAIR);
  466.   return 0;
  467. }
  468.  
  469.  
  470. long alloc_subtyped( len, subtype, obj )
  471. long len, subtype;
  472. SCM_obj *obj;
  473. { long len1 = len + 4;        /* length including header                */
  474.   long len2 = ceiling8(len1); /* length including padding for alignment */
  475.   if (pstate->heap_ptr-len2 < pstate->heap_lim)
  476.   { os_err = "Heap overflow"; return 1; }
  477.   pstate->heap_ptr -= len2;
  478.   *(long *)(pstate->heap_ptr) = SCM_make_header( len, subtype );
  479.   *obj = (SCM_obj)(pstate->heap_ptr + SCM_type_SUBTYPED);
  480.   return 0;
  481. }
  482.  
  483.  
  484. long alloc_vector( len, obj )
  485. long len;
  486. SCM_obj *obj;
  487. { return alloc_subtyped( len*sizeof(SCM_obj), (long)SCM_subtype_VECTOR, obj );
  488. }
  489.  
  490.  
  491. long alloc_symbol( name, obj )
  492. char *name;
  493. SCM_obj *obj;
  494. { SCM_obj probe, sym, sym_name;
  495.   long len = 0, h = 0;
  496.   while (name[len] != '\0')
  497.     h = ((h<<8)+(unsigned)name[len++]) % (long)SYMBOL_TABLE_LENGTH;
  498.   probe = SCM_obj_to_vect(sstate->globals[SYMBOL_TABLE].value)[h];
  499.   while (probe != SCM_null)
  500.   { sym = *(SCM_obj *)(probe-SCM_type_PAIR+PAIR_CAR*sizeof(SCM_obj));
  501.     sym_name = SCM_obj_to_vect(sym)[SYMBOL_NAME];
  502.     if (SCM_length( sym_name ) == len)
  503.     { long i = len;
  504.       char *str = SCM_obj_to_str(sym_name);
  505.       while (i > 0) { i--; if (str[i] != name[i]) goto not_found; }
  506.       *obj = sym;
  507.       return 0;
  508.     }
  509.     not_found:
  510.     probe = *(SCM_obj *)(probe-SCM_type_PAIR+PAIR_CDR*sizeof(SCM_obj));
  511.   }
  512.  
  513.   if (alloc_subtyped( ((long)SYMBOL_SIZE)*sizeof(SCM_obj), (long)SCM_subtype_SYMBOL, &sym )) return 1;
  514.   if (alloc_const_string( name, &SCM_obj_to_vect(sym)[SYMBOL_NAME])) return 1;
  515.   SCM_obj_to_vect(sym)[SYMBOL_PLIST]  = SCM_null;
  516.   SCM_obj_to_vect(sym)[SYMBOL_GLOBAL] = SCM_false;
  517.   if (alloc_pair( &probe )) return 1;
  518.   *(SCM_obj *)(probe-SCM_type_PAIR+PAIR_CAR*sizeof(SCM_obj)) = sym;
  519.   *(SCM_obj *)(probe-SCM_type_PAIR+PAIR_CDR*sizeof(SCM_obj)) =
  520.     SCM_obj_to_vect(sstate->globals[SYMBOL_TABLE].value)[h];
  521.   SCM_obj_to_vect(sstate->globals[SYMBOL_TABLE].value)[h] = probe;
  522.  
  523.   *obj = sym;
  524.   return 0;
  525. }
  526.  
  527.  
  528. long alloc_global( name, index )
  529. char *name;
  530. long *index;
  531. { SCM_obj sym;
  532.   if (alloc_symbol( name, &sym )) return 1;
  533.   return alloc_global_from_symbol( sym, index );
  534. }
  535.  
  536.  
  537. long alloc_global_from_symbol( sym, index )
  538. SCM_obj sym;
  539. long *index;
  540. { if (SCM_obj_to_vect(sym)[SYMBOL_GLOBAL] == SCM_false) /* var allocated? */
  541.   { long i = SCM_obj_to_int( sstate->globals[GLOBAL_VAR_COUNT].value );
  542.     if (i >= MAX_NB_GLOBALS)
  543.     { os_err = "Global variable table overflow"; return 1; }
  544.     SCM_obj_to_vect(sym)[SYMBOL_GLOBAL] = SCM_int_to_obj(i);
  545.     sstate->globals[GLOBAL_VAR_COUNT].value = SCM_int_to_obj(i+1);
  546.     *index = i;
  547.   }
  548.   else
  549.     *index = SCM_obj_to_int(SCM_obj_to_vect(sym)[SYMBOL_GLOBAL]);
  550.   return 0;
  551. }
  552.  
  553.  
  554. long set_global( name, value )
  555. char *name;
  556. SCM_obj value;
  557. { long index;
  558.   if (alloc_global( name, &index )) return 1;
  559.   sstate->globals[index].value = value;
  560.   return 0;
  561. }
  562.  
  563.  
  564. char *local_malloc8( len )
  565. long len;
  566. { char *temp1 = pstate->local_heap_ptr;
  567.   char *temp2 = temp1 + ceiling8( len );
  568.   if (temp2 > pstate->local_heap_top) return NULL;
  569.   pstate->local_heap_ptr = temp2;
  570.   return temp1;
  571. }
  572.  
  573.  
  574. char *local_mark()
  575. { return pstate->local_heap_ptr;
  576. }
  577.  
  578.  
  579. void local_release( mark )
  580. char *mark;
  581. { pstate->local_heap_ptr = mark;
  582. }
  583.  
  584.  
  585. /*---------------------------------------------------------------------------*/
  586.